(* PROJET : MODELISATION D'UN TELEPHONE À L'AIDE D'UN AUTOMATE
   Plusieurs degrés de difficulté et les intervalles de notes associés
   [12...] 
      - un moteur d'automate 
      - un automate avec stockages des données dans une pile et qui modélise les fonctionnalités suivantes :
         . on/off
         . verification du code pin=1718 avant de pouvoir passer des appels
         . appel possible vers 18, 17, S O S même sans code pin
         . composition/appel d'un numéro à 6 chiffres

   [14...] exigences précédentes mais 
       - pour les automates à pile
       - vérification du code pin = a^n+1.b^n+1
       - bloquer le téléphone après deux essais infructueux de pin
					       
   [15...] exigences précédentes mais 
       - vérification du code pin = palindrome avec marque * au milieu
         
   [17...] exigences précédentes mais 
       - pour les automates à pile non déterministe
       - vérification du code pin = palindrome sans marque au milieu

   [18...] exigences précédentes mais 
       - vérification du code pin = palindrome sans marque au milieu contenant les symboles 1 7 1 8 (dans cet ordre mais potentiellement avec d'autres symboles au milieu).
          Exemple1: a1b71c8c17b1a fait l'affaire et il est difficile de deviner qu'elle est votre mot de passe 
          Exemple2: 127731787137721 fait l'affaire
          Exemple3: 1718171 est le mot le plus court qui satisfait les conditions pour être un pin valide
*)


(* EXÉCUTION DANS L'INTERPRÉTEUR OCAML
   ledit ocaml
   #use "main.ml";;
*)

(* COUNTER *)

let _id = ref 0 ;;

let newid () = begin _id:=!_id + 1 ; !_id end




(* OPERATIONS on LIST *)

let rec (foreach: 'x list -> ('x -> 'y list) -> 'y list) = fun xs f -> 
      match xs with 
      | [] -> []
      | x::others -> (f x) @ (foreach others f)



(* OPERATIONS on STACK *)

module Pattern = 
  struct 
    type 'a pattern = 
      | ANY
      | KEY of 'a
      | BUT of 'a 
      |	IN  of 'a list
      |	OUT of 'a list

	  
    type 'a t = 'a pattern     (* defines the type Pattern.t *)
	
    let (exactly: 'a pattern -> 'a -> bool) = fun pattern a -> 
      pattern = KEY a
      
    let (matches: 'a pattern -> 'a -> bool) = fun pattern a ->
      match pattern with 
	| ANY -> true
	| KEY a' -> a' = a
	| BUT a' -> a'<>a
	| IN  aS -> List.mem a aS
	| OUT aS -> not (List.mem a aS)
	  
    let (pretty: ('a -> string) -> 'a pattern -> string) = fun pp pattern ->
      match pattern with
	| ANY -> "_"
	| KEY a -> pp a
	| BUT a -> "~" ^ (pp a)
	| IN  aS -> "{" ^ (String.concat "," (List.map pp aS)) ^ "}"
	| OUT aS -> "~{" ^ (String.concat "," (List.map pp aS)) ^ "}"

    let (print: ('a -> string) -> 'a pattern -> unit) = fun pp pattern -> 
      print_string (pretty pp pattern)
	
  end
    
    
module Stack =
struct 
    type 'a stack = 'a list
	
    type 'a t = 'a stack     (* defines the type Stack.t *)
	
    let (empty: 'a stack) = []
      
    let (is_empty: 'a stack -> bool) = function [] -> true | _ -> false
      
	let (string_stack: 'a stack -> string) = fun s ->
		let to_print = "stack = [" in
		let rec (aux:'a stack -> string -> string) = fun st to_print ->
			match st with
			[] -> to_print^"]"
			|a::s -> aux s (to_print^"\""^a^"\";")
		in aux s to_print
	
	
    let (top: 'a stack -> 'a option) = function [] -> None | a::_ -> Some a
      
    let rec (pop: int -> 'a stack -> 'a stack) = fun n stack ->
      if n=0 then stack 
      else match stack with 
	| [] -> []
	| _::stack_tail -> pop (n-1) stack_tail
	  
    let (push: 'a -> 'a stack -> 'a stack) = fun a s -> a::s

    let (stack: 'a stack -> 'a stack -> 'a stack) = fun s1 s2 -> s1 @ s2

    let (swap: 'a stack -> 'a stack) = function 
      | [] -> []
      | [a] -> [a]
      |	a1::a2::s -> a2::a1::s

    let (glue: 'a stack -> 'a stack) = function
      | [] -> []
      | [a] -> [a]
      |	a1::a2::s -> (a1^a2)::s
	
    let rec (is_prefix: ('a Pattern.t) stack -> 'a stack -> bool) = fun p_stack a_stack ->
      match p_stack,a_stack with
	| [],_ -> true
	| p::pS, a::aS -> Pattern.matches p a && is_prefix pS aS 
	| _,_ -> false
	  
	let (sub: 'a stack -> 'a stack) = function
		| [] -> []
		| a::s ->  
			let l = String.length a in
			if l<1 then ""::s
			else (String.sub a 0(l-1))::s
	 
    type 'a pretty_printer = 'a -> string
	
    let (pretty: 'a pretty_printer -> 'a stack -> string) = fun pp stack -> "[" ^ (String.concat "; " (List.map pp stack)) ^ "]"
      
    let (print: 'a pretty_printer -> 'a stack -> unit) = fun pp stack -> print_string (pretty pp stack)
      
end
  
  
(* THE TYPES *)
  
(* the keys of a phone are represented as strings, thus they comprise letters "a","b",... and also words "on","off","enter",... *)
  
type key = string
    
(* the automata read a sequence of keys *)

type 't sequence = 't list
    
type inputs = key sequence
    
(* the stack stores the keys hit by the user *)
    
type stack = key Stack.t
    
(* a automaton is a graph of transition between nodes *)
    
type node = int 
    
(* a transition between nodes bear a sequence of commands that is controlled by a symbol and a stack prefix *)
    
type transition = node * symbol * prefix * command sequence * node

(* a symbol is a pattern that recognizes a key *)
    
and symbol = key Pattern.t 
    
(* a the stack prefix of stack automaton recognizes the beginning of the current stack of keys *)
    
and prefix = symbol Stack.t
    
(* a command is an operation that modifies the state of a process *)
    
and command = key -> state -> state
    
(* a state of the execution of an automaton is defined bu the current node and current stack *)
    
and state = { node: node ; stack: stack }
    
(* the graph of the automaton is represented as a collection of transitions *)
    
type automaton = { name: string ; transitions: transition list }
    
(* a process has an identifier and a state *)
    
type process = { id: int ; state: state }
    
(* a system is a set of processes that reacts to some input from the outside world *)
    
type system_state = { inputs: inputs ; processes: process list }
    
type system  = { automaton: automaton ; system_state: system_state }
    
    
    
(* THE MODULES TO WRITE *)
    
module Command = 
struct
  
  type t = command
      
  let (pretty_print_string: string -> unit) = fun string -> print_string ("\n\n* " ^ string)
    
    (* command without additional argument *)

  let (skip: command) = fun _ state -> state
    
  let (forget: command) = fun _ state -> 
    { state with stack = Stack.empty }
      
  let (top: command) = fun _ state ->
			(*------affiche sommet de pile et retourne state inchangé---------------------------------------------------------------------- OK ?*)
    let sommet = Stack.top state.stack in
    let affiche = 
      match sommet with
	  None -> "Pile vide"
	| Some a -> a
    in
  	begin
      pretty_print_string affiche;
      state
    end
      
	let (push: command) = fun key state ->
    { state with stack = Stack.push key state.stack }
      
  let (pop: command) = fun _ state ->
    { state with stack = Stack.pop 1 state.stack }
      
  let (swap: command) = fun _ state ->
    { state with stack = Stack.swap state.stack }
      
    let (glue: command) = fun _ state ->
      { state with stack = Stack.glue state.stack }
	let (undo: command) = fun _ state -> (* retire le dernier caractere du premier element de la pile *)
		{ state with stack = Stack.sub state.stack }
		
	
    (* command with ONE additional string argument *)
	
    type argument = string
	
    let (print: string -> command) = fun string _ state ->
      (*-------------------------------------------------------------------------------------------------------------------------------------------------------- OK*)
      begin
	pretty_print_string string;
	state
      end
	
    let (push_word: string -> command) = fun data _ state ->
      { state with stack = Stack.push data state.stack } (* --------------------------------------------------------------------------------------------------------- OK*)
	
	
end
  
  
let epsilon = ""
  
  
module Automaton =
struct
  type t = automaton
      
  let (initial_node: node) = 1
    
  let (initial_state: state) = { node = initial_node ; stack = Stack.empty }
    
  let (empty: automaton) = { name = "" ; transitions = [] }
    
  let (make: string -> transition list -> automaton) = fun name transitions -> 
    { name = name ; transitions = transitions } (* ------------------------------ OK *)
      
  let (print_key: key -> unit) = fun key -> 
    print_endline key;; (* ------------------------------------------------------- OK*)
  
    (* applying an enabled transition *)
  
  let (print_transition_on: transition -> key -> unit) = fun t key ->
    let (src,symbol,prefix,_,tgt) = t 
    in
    print_string 
      (String.concat "" 
	 [ "(" ; string_of_int src ; ")-- " 
	 ; key ; ":" ; Pattern.pretty (fun str -> str) symbol
	 ; " -->(" ; string_of_int tgt ; ")" 
	 ] ) 
      
      
  let (apply_transition_on: state -> key -> transition -> state) = fun state key transition ->
    let (_,_,_,command_sequence,tgt) = transition
    in
    let rec (apply_transition_on_rec: state -> command sequence -> state) = fun state sequence ->
      match sequence with
	| [] -> {state with node = tgt }
	| command::other_commands ->
	  let state' = command key state
	  in apply_transition_on_rec state' other_commands
    in 
    begin
      print_key key ;
      print_transition_on transition key;
      apply_transition_on_rec state command_sequence
    end
      
    (* We implemented the non-deterministic version.
     * Note that the deterministic version would return just ONE state instead of a state LIST 
     *)
      
  let (one_step_of:automaton -> key -> state -> state list ) = fun automaton key state -> 
    (* -----------------------------------------------------------------------------------OK *)
    let enabled_transition =
      let filtre = fun t -> let (node,sym,prefix,_,_) = t in (node = state.node) && (Pattern.matches sym key) && (Stack.is_prefix prefix state.stack)  in
      List.filter filtre (automaton.transitions)
      in
    (* ---------------------------------------------------------------------------- OK*)
    
    match enabled_transition with
			[] -> [] (* failwith "Pas de transition possible. Faire sauter le processus" *)
      | [t] -> [apply_transition_on state key t]
      |_ -> List.map (fun t -> (apply_transition_on state key t)) enabled_transition (*failwith "Plus d'une transition. Non deterministe ?" *)	  
end
  
module Process = 
struct
  type t = process
      
	  
  let (string_state: state -> string) = fun state ->
	"state = { node = "^string_of_int state.node^" ;  "^Stack.string_stack state.stack^"}"
  let (string_process: process -> string) = fun p ->
	"{id = "^string_of_int p.id^"; "^string_state p.state^"} ; \n"
	
  let (start_at: state -> process) = fun state ->
    { id = newid () ; state = state }
      
    (* the difference between non deterministic and deterministic version is the result of one_step_of: 
     *  - a process in the deterministic version
     *  - a process list in the non deterministic version 
     *)
      
  let (one_step_of: automaton -> key -> process -> process list ) = fun automaton key process ->
      (*-------------------------------------------------------------------------------OK*)
			let sl = Automaton.one_step_of automaton key (process.state) in
			List.map (fun s -> {process with state = s}) sl (* ne crée que des processus avec 1 en id : temp *)
      
  let (move_each_wrt: automaton -> key -> process list -> process list) = fun automaton key processes ->
      (*-------------------------------------------------------------------------------OK*)
    foreach processes (fun process -> one_step_of automaton key process) 
end
  
  
  
module SystemState = 
struct
  type t = system_state
      
  let (empty: system_state) = { inputs = [] ; processes = [] } 
  
  let (print_input: inputs -> unit) = fun input ->
	let to_print = "inputs \t = [" in
	let rec (aux:inputs -> string -> string) = fun input to_print ->
		match input with
			[] -> to_print ^ "];"
			|a::s -> aux s (String.concat "" [to_print;"\"";a;"\" ; "])
	in print_endline (aux input to_print)
  
  let (print_processes: process list -> unit) = fun procs ->
	let to_print = "processes = [ " in
	let rec (aux:process list->string-> string) = fun procs to_print ->
		match procs with
			[] -> to_print ^ "]"
			|a::s -> aux s (String.concat "" [to_print; Process.string_process a])
	in print_endline (aux procs to_print)
  
  
  let (print_sysState: t-> unit) = fun ss ->
	print_newline ();
	print_endline "system_state =";
	print_string "{ ";
	print_input ss.inputs;
	print_processes ss.processes;
	print_endline "}"
	
	
  let (make_from: inputs -> system_state) = fun inputs ->
    { 
      inputs = inputs ;
      processes = [ Process.start_at Automaton.initial_state ]
    } 
      
  let (equal: t -> t -> bool) = fun s1 s2 ->
    s1.inputs = s2.inputs && s1.processes = s2.processes
    
  let (one_step_on: key -> automaton -> t -> t) = fun key automaton state ->
      (*-------------------------------------------------------------------------------OK*)
    {state with processes = let p = Process.move_each_wrt automaton key state.processes in
			match p with
				[] -> failwith "Y'a plus de processus"
				|_ -> p}
      
  let (one_step: automaton -> t -> t) = fun automaton state ->
      (*-------------------------------------------------------------------------------OK*)
	  print_sysState state;
    one_step_on (List.hd state.inputs) automaton {state with inputs = List.tl state.inputs}
      
    (* Two other running modes, useful for testing *)
      
    (* the system completes its run until it reaches the given stopping symbol   *)
      
  let rec (run_until: key -> automaton -> t -> t) = fun stop automaton ss ->
    match ss.inputs with
      | [] -> ss 
      | input::_ when input=stop -> ss
      | _ -> run_until stop automaton (one_step automaton ss)
    (* the system runs on a given scenario *)
	
  let rec (run_on: inputs -> automaton -> t -> t) = fun scenario automaton ss ->
	print_sysState ss;
    let pause = "@PAUSE@" 
    in let ss' = run_until pause automaton { ss with inputs = scenario @ [ pause ] @ ss.inputs }
       in (* remove the pause *)
       { ss' with inputs = List.tl ss'.inputs }
	 
end
  
  
  
module System = 
struct
  type t = system
      
  let (empty: system) = { automaton = Automaton.empty ; system_state = SystemState.empty }
    
  let (make_from: automaton -> inputs -> system) = fun automaton inputs ->
    { 
      automaton = automaton ;
      system_state = SystemState.make_from inputs 
    } 
      
  let (one_step: system -> system) = fun system ->
    { system with
      system_state = SystemState.one_step system.automaton system.system_state
    }
      
  let (run_on: inputs -> system -> system) = fun inputs system ->
    { system with
      system_state = SystemState.run_on inputs system.automaton system.system_state 
    } 
      
end
  
  
(* THE AUTOMATON *)
(*----------------------------------------------------------------------------------*)
let string_of_char charac = String.make 1 charac;;

let string_to_list s =
  let rec aux n list =
    if n< 0 then list
    else aux (n-1) (string_of_char(s.[n])::list)
  in aux (String.length s - 1) [];;
    
  
(* the alphabet *)
(*-------------------------------------------------------------------------------*)
let lowercase = string_to_list "abcdefghijklmnopqrstuvwxyz"
(*-------------------------------------------------------------------------------*)
let uppercase = string_to_list "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 
  
let letter = lowercase @ uppercase
(*-------------------------------------------------------------------------------*)
let digit = string_to_list "0123456789"
  
let separator = [" " ; ";"]
  
let alphabet = letter @ digit @ separator

open Pattern (* in order to be able to use KEY, ANY, BUT, IN, OUT *)

(* STATE NAMING CONVENTION: initial_node = 1, final choice = 0, black_hole = -1 *)

(* an operating system as an automaton

let operating_system = 
  [ (1, KEY "on" ,[],[Command.print "BOOTING"],0)
  ; (0, KEY "off",[],[Command.print "SHUTING DOWN" ; Command.forget ],1)  
  ; (-1,KEY "off",[],[Command.print "SHUTING DOWN" ; Command.forget ],-2)
  ; (0, KEY "pin",[],[Command.print "Wait for pin"],1000)
  ] 
;;
	*)


(* URGENCE BEFORE PIN, non-deterministe*)

(*
let urgence_call_before =
  [ (1, KEY "ON",[],[Command.push_word "PIN";Command.print "BOOTING"],2)
  ; (2, KEY "URG",[],[Command.print "Urgence call"],21)
  ; (21,KEY "1",[],[Command.print "1"],22)
  ; (22, KEY "7",[],[Command.print "17"],23)
  ; (22, KEY "8",[],[Command.print "18"],23)
  ; (23, KEY "CALL",[],[Command.print "Urgence calling"],27)
  ; (21, IN ["S";"s"],[],[Command.print "S."],24)
  ; (24, IN ["O";"o"],[],[Command.print "S.O."],25)
  ; (25, IN ["S";"s"],[],[Command.print "S.O.S"],26)
  ; (26, KEY "CALL",[],[Command.print "Calling"],27)
  ; (27, KEY "HANG UP",[],[Command.print "Hang up"],2)
  ; (22, KEY "CANCEL",[],[Command.print ""],2)
  ; (23, KEY "CANCEL",[],[Command.print ""],2)
  ; (26, KEY "CANCEL",[],[Command.print ""],2)
  ; (25, KEY "CANCEL",[],[Command.print ""],2)
  ; (24, KEY "CANCEL",[],[Command.print ""],2)
  ]
;;
(* CHECK PIN *)
let check_pin = 
  [ (2, KEY "1",[],[Command.print "*"],3)
  ; (3, KEY "7",[],[Command.print "**"],4)
  ; (4, KEY "1",[],[Command.print "***"],5)
  ; (5, KEY "8",[],[Command.print "****"],6)
  ; (6, KEY "VALIDATE",[],[Command.print "OK"],7)
  ; (6, KEY "CANCEL",[],[Command.print ""],2)
  ; (5, KEY "CANCEL",[],[Command.print ""],2)
  ; (4, KEY "CANCEL",[],[Command.print ""],2)
  ; (3, KEY "CANCEL",[],[Command.print ""],2)
  ]
;;

let check_pin14 = (* etat 1000 est la reussite du pin, etat 1001 l'echec du pin, à arranger *)
	[ (-1, ANY,[],[Command.print "Telephone bloqué"],-1)
	; (2, KEY "a",[KEY "PIN"],[Command.push],3)
	; (2, OUT ["a";"URG"],[],[Command.print "Echec du pin"],2)
	; (3, KEY "a",[],[Command.push],3) (*On accumule les a*)
	; (3, KEY "b",[KEY "a"],[Command.pop],4) (*Si b, on commence a compter les b*)
	; (3, OUT ["a";"b"],[],[Command.forget;Command.push_word "PIN";Command.print "Echec du pin"],2) (*Si ni a, ni b, pin raté*)
	; (4, KEY "b",[KEY "a"],[Command.pop],4) (*On decompte les b *)
	; (4, KEY "VALIDATE",[KEY "PIN"],[Command.forget;Command.push_word "PIN_OK";Command.print "Pin valide"],7) (* PIN REUSSIS*)
	; (4, KEY "VALIDATE",[BUT "PIN"],[Command.forget;Command.push_word "PIN";Command.print "Echec du pin"],2)
	; (4, OUT ["b";"VALIDATE"],[],[Command.forget;Command.push_word "PIN";Command.print "Echec du pin"],2)
	; (2, KEY "CANCEL",[],[Command.print ""],2) (* *)
	; (3, KEY "CANCEL",[],[Command.print ""],2) (* *)
	; (4, KEY "CANCEL",[],[Command.print ""],2) (* *)
	]
;;

 
(* CALL *)
let normal_call = 
  [ (7, IN ["0";"2";"3";"4";"5";"6";"7";"8";"9"],[],[Command.print ""],13)      (* creer un pattern pour digit sauf 1*)
  ; (13, IN ["0";"1";"2";"3";"4";"5";"6";"9"],[],[Command.print ""],14)
  ; (14, IN digit,[],[Command.print ""],15)
  ; (15, IN digit,[],[Command.print ""],16)
  ; (16, IN digit,[],[Command.print ""],17)
  ; (17, IN digit,[],[Command.print ""],18)
  ; (18, KEY "CALL",[],[Command.print "Calling"],19)
  ; (19, KEY "HANG UP",[],[Command.print "Hang up"],7)
  ; (13, KEY "CANCEL",[],[Command.print "CANCEL"],7)
  ; (14, KEY "CANCEL",[],[Command.print "CANCEL"],7)
  ; (15, KEY "CANCEL",[],[Command.print "CANCEL"],7)
  ; (16, KEY "CANCEL",[],[Command.print "CANCEL"],7)
  ; (17, KEY "CANCEL",[],[Command.print "CANCEL"],7)
  ; (18, KEY "CANCEL",[],[Command.print "CANCEL"],7)
  ]
;;
(* URGENCE CALL AFTER PIN*)
let urgence_call_after = 
  [ (7, KEY "1",[],[Command.print "1"],11)
  ; (11, KEY "7",[],[Command.print "17"],12)
  ; (11, KEY "8",[],[Command.print "18"],12)
  ; (12, IN digit,[],[Command.print ""],15)
  ; (12, KEY "CALL",[],[Command.print "Calling"],20)
  ; (20, KEY "HANG UP",[],[Command.print "Hang up"],7)
  ; (7, IN ["S";"s"],[],[Command.print "S"],8)
  ; (8, IN ["O";"o"],[],[Command.print "S.O."],9)
  ; (9, IN ["S";"s"],[],[Command.print "S.O.S"],10)
  ; (10, KEY "CALL",[],[Command.print "Calling"],20)
  ]
;;

let off_button =
	[ (2, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (3, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (4, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (5, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (6, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (7, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (8, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (9, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (10, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (11, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (12, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (13, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (14, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (15, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (16, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (17, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (18, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (19, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (20, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (21, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (22, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (23, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (24, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (25, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (26, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
	; (27, KEY "OFF",[],[Command.print "SHUTING DOWN"],1)
  ]
;;
*)
(* the pin code verification *)
(*
let check_pin =  (*----------------------------------------------------------------------*)
  [ (1000, KEY "1",[],[Command.print "Vous avez entré"],1001)
  ; (1000, BUT "1",[],[Command.print "Pin incorrecte"],0)
  ; (1001, KEY "7",[],[Command.print "Vous avez entré"],1002)
  ; (1002, KEY "1",[],[Command.print "Vous avez entré"],1003)
  ; (1003, KEY "8",[],[Command.print "Vous avez entré";Command.print "PIN CORRECT"],2)
  ] 
*)  

(*-----V2------*)

let urgence = 
	[ (1,KEY "on",[],[Command.forget;Command.push_word "";Command.push_word "pin";Command.print "LOADING"],2)
	; (2,KEY "urg",[],[Command.print "Menu d'appel d'urgence"],13) 
	; (13,IN alphabet,[],[Command.swap;Command.push;Command.swap;Command.glue;Command.swap],13)
	; (13,KEY "call",[IN ["fail";"pin";"pin_ok"];IN["sos";"17";"18"]],[Command.swap;Command.print "Calling:";Command.top;Command.pop],14)
	; (13,KEY "call",[IN ["fail";"pin";"pin_ok"];OUT["sos";"17";"18"]],[Command.swap;Command.pop],13)
	; (14,KEY "hang_up",[KEY "pin"],[Command.print "Hang up";Command.forget;Command.push_word "";Command.push_word "pin"],2)
	; (14,KEY "hang_up",[KEY "fail"],[Command.print "Hang up";Command.forget;Command.push_word "";Command.push_word "fail"],2)
	; (14,KEY "hang_up",[KEY "pin_ok"],[Command.print "Hang up";Command.forget;Command.push_word "";Command.push_word "pin_ok"],5)
	(* BACK *)
	; (13,KEY "back",[OUT ["pin";"fail"]],[Command.print "Back";Command.undo],13)
	; (13,KEY "back",[IN ["pin";"fail"]],[Command.print "Unknow button"],13)
	(* CANCEL *)
	; (13,KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin";Command.print "Cancel"],2)
	
	; (5, KEY "urg",[],[Command.print ""],13)
	]

(*
(*check pin ne bloquant pas le telephone *)
let check_pin =
	[ (-1, ANY,[],[Command.print "Telephone bloqué"],-1)
	; (2, KEY "a",[KEY "pin";KEY ""],[Command.swap;Command.push;Command.glue],3)
	; (2, OUT ["a";"urg"],[],[Command.print "Echec du pin"],2)
	; (3, KEY "a",[],[Command.push],3) (*On accumule les a*)
	; (3, KEY "b",[KEY "a"],[Command.pop],4) (*Si b, on commence a compter les b*)
	; (3, OUT ["a";"b"],[],[Command.forget;Command.push_word "";Command.push_word "pin";Command.print "Echec du pin"],2) (*Si ni a, ni b, pin raté*)
	; (4, KEY "b",[KEY "a"],[Command.pop],4) (*On decompte les b *)
	; (4, KEY "validate",[KEY "pin"],[Command.forget;Command.push_word "";Command.push_word "pin_ok";Command.print "Pin valide"],5) (* PIN REUSSIS*)
	; (4, KEY "validate",[BUT "pin"],[Command.forget;Command.push_word "";Command.push_word "pin";Command.print "Echec du pin"],2)
	; (4, OUT ["b";"validate"],[],[Command.forget;Command.push_word "";Command.push_word "pin";Command.print "Echec du pin"],2)
	(* CANCEL *)
	; (2, KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin"],2)
	; (3, KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin"],2)
	; (4, KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin"],2)
	]
;;
*)

(* check pin qui bloque le telephone *)
let check_pin = 
	[ (-1, ANY,[],[Command.print "Telephone bloqué"],-1)
	; (2, KEY "a",[IN ["pin";"fail"]],[Command.glue;Command.push],3) (*On accumule au moins un a *)
	; (2, OUT ["a";"urg"],[KEY "pin"],[Command.pop;Command.push_word "fail";Command.print "Echec du pin"],2)
	; (2, OUT ["a";"urg"],[KEY "fail"],[Command.print "Echec du pin : Telephone bloqué"],-1)
	; (3, KEY "a",[],[Command.swap;Command.push],3) (*On accumule les a*)
	; (3, KEY "b",[KEY "a"],[Command.pop;Command.swap],4) (*Si b, on commence a compter les b*)
	; (3, OUT ["a";"b"],[ANY;KEY "pin"],[Command.forget;Command.push_word "";Command.push_word "pin";Command.print "Echec du pin"],2) (*Si ni a, ni b, pin raté*)
	; (3, OUT ["a";"b"],[ANY;KEY "fail"],[Command.forget;Command.print "Echec du pin : Telephone bloqué"],-1) (*Si ni a, ni b, pin raté*)
	; (4, KEY "b",[KEY "a"],[Command.pop;Command.swap],4) (*On decompte les b *)
	; (4, KEY "b",[KEY "pin"],[Command.forget;Command.push_word "";Command.push_word "pin";Command.print "Echec du pin"],2)
	; (4, KEY "b",[KEY "fail"],[Command.forget;Command.print "Echec du pin : Telephone bloqué"],-1)
	; (4, KEY "validate",[IN ["pin";"fail"]],[Command.forget;Command.push_word "";Command.push_word "pin_ok";Command.print "Pin valide"],5) (* PIN REUSSIS*)
	; (4, KEY "validate",[OUT ["pin";"fail"];KEY "pin"],[Command.forget;Command.push_word "";Command.push_word "fail";Command.print "Echec du pin"],2)
	; (4, KEY "validate",[OUT ["pin";"fail"];KEY "fail"],[Command.forget;Command.print "Echec du pin : Telephone bloqué "],-1)
	; (4, OUT ["b";"validate"],[BUT "fail";BUT "fail"],[Command.forget;Command.push_word "";Command.push_word "fail";Command.print "Echec du pin"],2)
	; (4, OUT ["b";"validate"],[ANY;KEY "fail"],[Command.forget;Command.print "Echec du pin : Telephone bloqué"],-1)
	; (4, OUT ["b";"validate"],[KEY "fail";ANY],[Command.forget;Command.print "Echec du pin : Telephone bloqué"],-1)
	(* CANCEL *)
	; (2, KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin"],2)
	; (3, KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin"],2)
	; (4, KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin"],2)
	]


let call = 
	[ (5,IN digit,[],[Command.swap;Command.push;Command.glue],6)
	; (6,IN digit,[],[Command.push;Command.swap;Command.glue],7)
	; (7,IN digit,[],[Command.push;Command.swap;Command.glue],8)
	; (8,IN digit,[],[Command.push;Command.swap;Command.glue],9)
	; (9,IN digit,[],[Command.push;Command.swap;Command.glue],10)
	; (10,IN digit,[],[Command.push;Command.swap;Command.glue],11)
	; (11,KEY "call",[],[Command.print "Calling:";Command.top],12)
	; (12,KEY "hang_up",[],[Command.print "hang up";Command.forget;Command.push_word "";Command.push_word "pin_ok"],5)
	(* BACK *)
	; (11,KEY "back",[],[Command.undo],10)
	; (10,KEY "back",[],[Command.undo],9)
	; (9,KEY "back",[],[Command.undo],8)
	; (8,KEY "back",[],[Command.undo],7)
	; (7,KEY "back",[],[Command.undo],6)
	; (6,KEY "back",[],[Command.undo],5)
	(* CANCEL *)
	; (11,KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin_ok"],5)
	; (10,KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin_ok"],5)
	; (9,KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin_ok"],5)
	; (8,KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin_ok"],5)
	; (7,KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin_ok"],5)
	; (6,KEY "cancel",[],[Command.forget;Command.push_word "";Command.push_word "pin_ok"],5)
	]
;;

let off_button =
	[ (2, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (3, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (4, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (5, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (6, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (7, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (8, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (9, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (10, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (11, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (12, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (13, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
	; (14, KEY "off",[],[Command.print "SHUTING DOWN";Command.forget],1)
  ]
;;

let etat1 = 
	[ (1,BUT "on",[],[Command.skip],1)
	; (5, OUT (["urg";"off"]@digit),[],[Command.print "Unknow button"],5)
	; (6, OUT (["back";"cancel";"off"]@digit),[],[Command.print "Unknow button"],6)
	; (7, OUT (["back";"cancel";"off"]@digit),[],[Command.print "Unknow button"],7)
	; (8, OUT (["back";"cancel";"off"]@digit),[],[Command.print "Unknow button"],8)
	; (9, OUT (["back";"cancel";"off"]@digit),[],[Command.print "Unknow button"],9)
	; (10, OUT (["back";"cancel";"off"]@digit),[],[Command.print "Unknow button"],11)
	; (11, OUT ["call";"back";"cancel";"off"],[],[Command.print "Unknow button"],11)
	; (12, OUT (["hang_up";"off"]@digit),[],[Command.print "Unknow button"],12)
	; (13, OUT (["call";"off"]@alphabet),[],[Command.print "Unknow button"],13)
	; (14, OUT (["hang_up";"off"]),[],[Command.print "Unknow button"],14)
	]
;;
(*----FIN V2---*)

(* a basic phone as an automaton *)

(* let phone = Automaton.make "MyPhone" (operating_system @ check_pin) ;;*)

let phone = Automaton.make "MyPhone" ( urgence @  call @ check_pin @ off_button @ etat1) ;;
(* TEST *)

(* useful function to RUN STEP BY STEP *)

let _sys = ref System.empty ;;

let (load: automaton -> inputs -> system_state) = fun automaton inputs ->
  begin
    _id := 0 ;
    _sys:= System.make_from automaton inputs ;
    !_sys.system_state
  end
    
let (step: unit -> system_state) = fun () ->
  begin
    _sys:= System.one_step !_sys ; 
    print_string "\n" ;
    !_sys.system_state
  end
    
let (run_on: automaton -> inputs -> system_state) = fun automaton inputs ->
  begin
    print_string (String.concat " " ([ "\n|\n| RUN OF " ; automaton.name ; " ON SCENARIO:" ; "[" ^ (String.concat " ; " inputs) ^ "]" ; "\n|\n"])) ;
    _id:=0 ;
    _sys:= System.make_from automaton [] ;
    _sys:= System.run_on inputs !_sys ; 
    !_sys.system_state
  end
    
(* test *)
let scenario_complete = [ "on";"a";"a";"b";"b";"validate";"urg";"1";"7";"call";"hang_up";"0";"6";"2";"1";"2";"3";"call";"hang_up";"off"];;

let scenario_wrong_button = ["on";"a";"b";"validate";"1";"2";"call";"3";"4";"6";"7";"call";"hang_up";"urg";"s";"o";"s";"call";"off"];;

let scenario_back = ["on";"a";"b";"validate";"1";"2";"3";"back";"4";"5";"6";"7";"call";"hang_up";"off"];;

let scenario_cancel = ["on";"a";"b";"validate";"1";"2";"3";"cancel";"8";"9";"4";"5";"6";"7";"call";"hang_up";"off"];;

let scenario_urgence_after_pin = ["on";"a";"b";"validate";"urg";"s";"o";"s";"call";"hang_up";"off";];;

let scenario_urgence_before_pin = ["on";"urg";"s";"o";"s";"call";"hang_up";"a";"b";"validate";"off"];;

let scenario_bad_pin = ["on";"a";"a";"b";"validate";"a";"b";"b";"validate"];;

(* RUN TO COMPLETION *)
(* ---------------------------------------------------------------------------*)
run_on phone scenario_complete;;
